

;; systmob3
;; Copyright (c) 1991-2001 by Forrest W. Young
;; Continuation of code for ViSta system object.  
;; Code for refreshing, constructing, and resizing the desktop


;
; REFRESH DESKTOP
;=======================

(defun refresh ()
  (refresh-desktop))

(defun refresh-desktop (&key first-time start-up)
  #+containers (send *listener* :pop-out nil)
 ; #+containers (send *desktop-container* :resize)
  (when *verbose* (report-sizes))
  #-containers(when (check-if-screen-size-changed t)
                    (resize-desktop nil :layout *layout-choice*))
 ; #+containers(send *vista* :resize)
  (if start-up
        (send *vista* :startup-refresh-desktop :first-time first-time)
        (send *vista* :refresh-desktop :first-time first-time))
  (when *verbose* (report-sizes))
  (menus)
  )

(defun start-desktop (&key (show t) (five-values))
(when *verbose* (print "Starting Desktop"))
  (cond
    (five-values (apply #'send *vista* :make-desktop-layout five-values))
    ((check-if-screen-size-changed nil)
     (resize-desktop nil :layout *layout-choice*))
    (t
     (send *vista* :startup-refresh-desktop :first-time t :show show)))
  (when *verbose* (report-sizes))
  )

(defun check-if-screen-size-changed (msg)
  (when *verbose* (report-sizes))
  (cond
    ((reset-screen-size)
     (when msg (message-dialog (format nil "Adapting to Screen Size")))
     t)
    (t nil)))


(defun show-desktop ()
  #+containers(send *desktop-container* :hide-window)
  (send *desktop-datasheet* :show-window)
  (send *vista* :refresh-desktop)
  #+containers(send *desktop-container* :show-window)
  )

(setf *change-layout-type* nil)

#+containers
(defun show-desktop ()
	(show-vista))

(defun refresh-workmap ()
  (when (send *workmap* :screen-saver)
        (send *workmap* :reset-screen-saver))
  (send *workmap* :postpone-redraw nil)
  (send *vista* :adjust-workmap-sizeloc 
        (send *vista* :show-varobs) nil nil))

(defmeth vista-system-object-proto :refresh-desktop (&key first-time resize)
  (when (send *workmap* :screen-saver)
        (send *workmap* :reset-screen-saver))
  #+macintosh (if *macos8* 
                  (send *listener* :location 10 18)
                  (send *listener* :location 10 18))
  #+macintosh(send *listener* :size 490 280)
  (send *vista*  :ready-to-redraw *workmap* )
  (send *workmap* :postpone-redraw nil)
  (send *workmap* :redraw)
  (send *vista*  :finished-redraw *workmap* )
  (when *desktop-datasheet*
        (send *vista*  :ready-to-redraw *desktop-datasheet*)
        (send *vista* :finished-redraw *desktop-datasheet*)
        )
  (send *watcher* :close)
  (send command-menu-hide-desktop-item :enabled t)
  (send *vista* :adjust-workmap-sizeloc 
        (send *vista* :show-varobs)
        nil ;(or (not (send *vista* :hide-workmap)) (send *workmap* :gui))
        first-time)
#+containers(when (not *ni*)
                  (apply #'listener (combine 4 4 
                       (first (send *workmap* :frame-size)) 75)))

  (send self :adjust-varobs-sizeloc (send *vista* :show-varobs))
  (LOOP 
   (WHEN (NOT (SEND *WORKMAP* :POSTPONE-REDRAW)) (RETURN)))
  (when *datasheet* 
        (unless *free-datasheets*
                (when (not (send *datasheet* :showing))
                      (send *vista* :adjust-datasheet-sizeloc nil first-time))
                ))
  (unless *free-datasheets*
          (send *vista* :adjust-datasheet-sizeloc nil first-time))
  (when (send *vista* :guidemap) 
        (send *vista* :adjust-guidemap-sizeloc)
        (send *guidemap* :gui t))
  (send *workmap* :gui t)
  (when *expertmap* (send *expertmap* :show-window))
  #+msdos(when *listener* 
               (send *listener* :pop-out nil)
               (send *vista* :adjust-listener-sizeloc))
  )

 
(defmeth vista-system-object-proto :startup-refresh-desktop 
                  (&key first-time resize show five-values)
  (when show (send command-menu-hide-desktop-item :enabled t))
  (send self :adjust-varobs-sizeloc (and show (send *vista* :show-varobs)))
  (when show (send *vista* :adjust-datasheet-sizeloc nil first-time))
  (when (and show (send *vista* :guidemap)) (send *guidemap* :gui t))
  (when (and show *expertmap*) (send *expertmap* :show-window)))
  
(defmeth vista-system-object-proto :adjust-workmap-sizeloc (varobs show first-time)
  #+msdos (if *change-layout-type* 
              (send *workmap* :location 2000 2000)
              (case *layout-type* 
                (0 (send *workmap* :location 4 44));44
                (1 (send *workmap* :location 1 2))))
  #+containers(when *ni* (if *change-layout-type* 
                             (send *workmap* :location 2000 2000)
                             (send *workmap* :location 4 24)))
  #+macintosh (if *macos8* 
                  (send *workmap* :location 7 42)
                  (send *workmap* :location 2 36))
  (let ((th (+ (send *workmap* :text-ascent)
               (send *workmap* :text-descent))))
    (when *ni* (send *vista* :desktop-size 
                     (- (send *desktop-container* :size) '(0 45)
                        (if (> *num-listener-lines* 0) ; *listener* 
                            (list 0 (+ 30 (if *seamless-desktop*  -8 8);-8 16
                                       (* th *num-listener-lines*))) 
                            '(0 18) 
                            )))))
  (let* ((p (send self :workmap-proportion))
         #+msdos(c 20)
         #-msdos (c 36)
         (d 0)
         (e 0)
         (listener-h 0)
         (desktop-h (second (send self :desktop-size)))
         (desktop-w (first (send self :desktop-size)))
         (workmap-h (floor (+ (*  p (- desktop-h listener-h -44)) )))
         (workmap-w 
          (if varobs 
              (- desktop-w c
                 (* 2 (if (> desktop-w 899) 130 104)))
              desktop-w))
         (workmap-size (list workmap-w workmap-h))
         )
    #+msdos(case *layout-type* 
             (0 (setf d 4)(setf e  0))
             (1 (setf d 8)(setf e 22)))
    #+macintosh(when (not *macos8*) (setf d 26) (setf e 0));e=0
    #+macintosh(when first-time (setf e 20))
    (send *workmap* :frame-size (+ workmap-w d) (+ workmap-h e))
    (send *workmap* :back-color 'workmap-background)
    (when show 
          (send *workmap* :gui t)
          #+msdos(send *workmap* :redraw))
   ; (send *workmap* :has-h-scroll (+ 100 (first (send *workmap* :size))))
   ; (send *workmap* :has-v-scroll (+ 100 (second (send *workmap* :size))))
    ))

(defmeth vista-system-object-proto :adjust-varobs-sizeloc (show)
  (let* ((nborders (if (= *layout-type* 0) 3 2));3 2
         (title (if (= *layout-type* 0) 0 42));0 22
         #+msdos(border (if *ni* 3 4))
         #-msdos(border 6);3
         (workmap-y (second (send *workmap* :location)))
         (obs-var-win-w (if (> (first (send self :desktop-size)) 899) 133 107))
         (obs-var-win-h (second (send *workmap* :size)))
         (obs-win-x (+ (* nborders border) 5 (first (send *workmap* :size))))
         (var-win-x (+ obs-win-x obs-var-win-w (* 2 border)))
         (obs-win-y workmap-y) ;(+ workmap-y title)
         (var-win-y (+ workmap-y title)) 
         )
   ; (if *long-varobs*
   ;     (setf obs-var-win-h (+ obs-var-win-h 
   ;                            (second (send *listener* :frame-size)))))
    #+macintosh(when (not *macos8*)
                     (setf border 4)
                     (setf obs-win-x (- obs-win-x 13))
                     (setf var-win-x (- var-win-x 22)))
    (cond 
      (*varobs-obj*
       (send *varobs-obj* :size 
             (+ 8 (* 2 obs-var-win-w)) obs-var-win-h) ; +7 ;+9
       (send *varobs-obj* :location obs-win-x obs-win-y)
       (send *obs-window* :back-color 'workmap-background)
       (send *var-window* :back-color 'workmap-background)
       (send *obs-window* :show-window)
       (send *var-window* :show-window)
       (if show (send *varobs-obj* :top-most) ;show-window
           (send *varobs-obj* :bottom-most))  ;hide-window
       )
      (t
       (send *obs-window* :size obs-var-win-w obs-var-win-h)
       (send *obs-window* :location obs-win-x obs-win-y)
       (send *var-window* :size obs-var-win-w obs-var-win-h)
       (send *var-window* :location var-win-x var-win-y)
       (cond (show (send *obs-window* :top-most) ;:show-window
                   (send *var-window* :top-most)) ;:show-window
         (t (send *obs-window* :bottom-most) ;:hide-window
            (send *var-window* :bottom-most))) ;:hide-window
       ))
    #-containers(progn
                 (send *watcher* :size (+ (* 2 border)(* 2 obs-var-win-w)) 12)
                 (send *watcher* :location obs-win-x border))
    (if show (send *watcher* :show-window))
       
    ))

;under windows when closed both location and frame location locate to same place
;but when open locate to different places. following moves closed window to place
;so that right when opened
(defmeth vista-system-object-proto :adjust-datasheet-sizeloc 
                (&optional dash first-time )
  (let* ((varobs (send *vista* :show-varobs))
         (desktop-w (first (send self :desktop-size)))
         (desktop-h (second (send self :desktop-size)))
         (workmap-w (first (send *workmap* :size)))
         (workmap-h (second (send *workmap* :size)))
         (p (send self :workmap-proportion))
         (const 28)     #-msdos(const 0)
         (const1 0)
         (const2 28) 
         (const3 28) 
         (listener-h 0)
  #-msdos(const3 16) ;24
         (const4 (if (= *layout-type* 0) 0 44))
         (const5 (if (= *layout-type* 0) 10 8));8 4
         (dash-h (+ (- desktop-h workmap-h listener-h (* 2 const3)) const4))
         )
    #+macintosh(when (not *macos8*) (setf const5 4))
    (unless dash 
            (setf dash 
                  (if *current-data* 
                      *datasheet* 
                      (if *initial-datasheet* 
                          *datasheet*
                          *fake-datasheet*))))
    (when (not dash) 
          (when *current-data*
                (setf *datasheet* (send *current-data* :datasheet-object))
                (setf dash *datasheet*)))
    (when dash
          #+macintosh (setf const (+ 2 window-decoration-height))
          #+msdos(when *current-data* 
                       (unless (send *datasheet* :showing) 
                               (when (not first-time) 
                                     (setf const 0))))
          #+macintosh(when (not *macos8*) (setf const2 20))
        ;  (send dash :location
        ;        (+ const1 (first (send *workmap* :location)) )
        ;        (+ const2 (second (+ (send *workmap* :location) 
        ;                            (send *workmap* :size)))))
          (send self :datasheet-location
                (list
                 (+ const1 (first (send *workmap* :location)) )
                 (+ const2 (second (+ (send *workmap* :location) 
                                      (send *workmap* :size))))))
          (cond 
            ((send *vista* :guidemap)
           ; (send dash :size workmap-w dash-h)
             (send self :datasheet-size (list workmap-w dash-h)))
            ((or *free-about-window* *fake-datasheet*)
            ;(send dash :size (first (- (send *vista* :desktop-size) const5)) dash-h)
             (send self :datasheet-size 
                   (list (first (- (send *vista* :desktop-size) const5)) dash-h)))
            (t 
            ;(send dash :size workmap-w dash-h)
             (send self :datasheet-size (list workmap-w dash-h))))
         ;(apply #'send dash :size (+ (send dash :size) '(1 0)))
          (send self :datasheet-size (+ (send self :datasheet-size) '(1 0)))
          (reset-graphics-buffer)
         ; (send dash :show-window)
          )
    ;(apply #'send dash :size (send self :datasheet-size))
    ;(apply #'send dash :location (send self :datasheet-location))
    (unless (> (send *vista* :workmap-proportion) .99)
            (send self :datasheet-size (send dash :size))
            (send self :datasheet-location (send dash :location)))
    ))



(defmeth vista-system-object-proto :adjust-listener-sizeloc ()
  (let* ((dashsiz (send self :datasheet-size))
         (dashloc (send self :datasheet-location))
         (th (+ (send *workmap* :text-ascent)    ;11
                (send *workmap* :text-descent))) ; 3
         (l1 0) (l2 -1) (s1 0) (s2 -1)
         )
    (unless (send *listener* :pop-out)
            (send *listener* :frame-location 0 
                  (if (< *num-listener-lines* 0)
                      (- (second (+ dashsiz dashloc)) 80)
                      (second (+ dashsiz 
                                 (if *seamless-desktop* 4 4);4 4 
                                 (if *thin-borders* l1 l2)
                                 dashloc))));4 
            (send *listener* :size (first dashsiz) 
                  (- (* th *num-listener-lines*) 
                     (if *full-screen-desktop* -20 0)
                     (if *seamless-desktop* 23 4);24 8 ;24 4  ;23 6 ; 23 4
                     (if *thin-borders* s1 s2))))))


;  (send *desktop-container* :resize)
;  (copyright)(terpri)(top-most nil)
;  (toplevel nil)
#|
;*seamless-desktop* t=no title bars
;*thin-borders* just that
;pixel size ok/ng; *num-listener-lines* 4/5; maximize ok/ng;
             
         titlebars
         t               nil
_______________________________________
0 1
thin     ok,5,ng         ok,5,ng
thick    ng(+1),5,ng     ng(+1),5,ng
______________________________________
0 2
thin     ok,5,ng         ok,5,ng
thick    ng(+1),4,ng     ng(+1),4,ng
______________________________________
size=0 0, loc=0 -1
thin     ok,5,ng         ok,5,ng
thick    ok,5,ng         ok,5,ng
|#

(defmeth vista-system-object-proto :adjust-about-sizeloc (&optional guidemap)
  (let* ((e 0)
         #+msdos(border 4);5
         #-msdos(border 6)
         (dash (if *current-data* *datasheet* *fake-datasheet*))
        (x (first (send *obs-window* :location)))
        (y (second (send dash :location)))
        (w (first (- (send self :desktop-size) 
                     (send dash :size) (* 4 border))))
        (h (second (send dash :size))))
    #+msdos(case *layout-type* 
            (0 (setf e 0))
            (1 (setf e 8)))
    (when (not *about-window*) (about-these-data))
    (cond
      ((send *vista* :guidemap)
       (send *guidemap* :size (+ w e) h)
       (send *guidemap* :location x y)
       (send *guidemap* :show-window)
       (send *vista* :guide-window-location x y)
       (send *vista* :guide-window-size (+ w e) h)
       )
      (t
       (send *about-window* :size (+ w e) h)
       (send *about-window* :location x y)
       (send *about-window* :show-window)))
    ))

(defmeth vista-system-object-proto :adjust-guidemap-sizeloc ()
  (send *vista* :adjust-about-sizeloc t))

;=======================
; RESIZE CONTAINER
;=======================

(defun make-desktop-container-resize ()
  (send *desktop-container* :make-desktop-container-resize))

;=======================
; RESIZE DESKTOP
;=======================

(defun resize-desktop (&optional preset-values &key minmax layout)
  (send *vista* :resize-desktop preset-values :minmax minmax :layout layout)
  )

(defmeth vista-system-object-proto :resize ()
  (reset-screen-size)
  (send self :resize-desktop nil :dialog nil))
 
(defmeth vista-system-object-proto :resize-desktop 
           (&optional preset-values &key minmax layout (dialog t))
  (let ((choice minmax)
        (result))
    (cond 
      (layout (setf choice layout))
      (minmax (if (= minmax 0) (setf choice 2) (setf choice 0)))
      ((not minmax)
       (if dialog
           (setf choice
                 (choose-item-dialog  
                  "Desktop and SpreadPlot Sizes:"
                  (list 
                   "3/4 Screen Layout"
                   "Custom Layout (Next Dialog)"
                   "Full Screen Layout" 
                   )
                  :initial *layout-choice*))
           (setf choice 2))))
    
    (when choice 
          (setf *layout-choice* choice)
          (when (send *workmap* :screen-saver)
                (send *workmap* :reset-screen-saver))
          (cond 
            ((= *layout-choice* 1) 
             (setf result (send self :resize-desktop-dialog))
             (when result
                   (setf result (send self :check-desktop-layout result))))
            (t
             (setf result (send self :set-default-desktop-sizes 
                                (if (= *layout-choice* 0) 1 0)))))
          (when result
                (apply #'send self :make-desktop-layout result)
                (send *workmap* :gui t)
                (send *vista* :workmap-size (send *workmap* :size))
                (send *vista* :workmap-location (send *workmap* :location))
                (setf *needs-desktop-resized* nil)
                (send *vista* :datasheet-size (send *datasheet* :size))
                (send *vista* :datasheet-location (send *datasheet* :location)))
          )))


(defmeth vista-system-object-proto :set-default-desktop-sizes (choice)
  (make-minmax-desktop-sizes choice))
         
(defun make-minmax-desktop-sizes (minmax)
  (let* ((listener-space 24);16
         (magic-constant listener-space)
         (title 18) ;0,22
         (menubar 44);44
         (title+menubar (+ title menubar))
  #-msdos(title+menubar 10)
         (ratio (send *vista* :workmap-proportion))
         (window-size (case minmax (0 *max-screen-size*) (1 *3/4-screen-size*)))
         (width (first window-size))
         (workmap+datasheet-height (- (second window-size) title+menubar listener-space))
         (spreadplot-height        (- (second window-size) title+menubar magic-constant))
         )
    (list width workmap+datasheet-height ratio width spreadplot-height)
    ))


(defmeth vista-system-object-proto :make-desktop-layout 
         (width height propor spwidth spheight)
  (let* ((dash (if *desktop-datasheet* *desktop-datasheet* *fake-datasheet*))
         (wmw (first (send *workmap* :frame-size)))
         (dsw (first (send dash :frame-size)))
         (wmhb4 (second (send *workmap* :frame-size)))
         (dshb4 (second (send dash :frame-size)))
         (listener-h 0)
         (wm+dshb4 (- (+ 24 wmhb4 dshb4) listener-h))
         (dswidth (first (send dash :size)))
         (h 0) (diff 0)
         )
    (send *workmap* :frame-size wmw (ceiling (* propor wm+dshb4)))
    (send dash :frame-size dsw (floor (* (- 1 propor) wm+dshb4)))
    (send self :workmap-size (list wmw (ceiling (* propor wm+dshb4))))
    (send self :datasheet-sizes 
          (list dswidth (- (+ wmhb4 dshb4) (ceiling (* propor height)))))
    (setf h (second (+ (send self :datasheet-size) (send self :datasheet-location))))
    (setf diff (- (second (send self :desktop-size)) h))
    (if (< diff 0) 
       (send self :datasheet-sizes 
             (list dswidth
                   (+ (second (send self :datasheet-sizes)) 20 diff))))
    (send self :desktop-size (list width height))
    (send self :spreadplot-sizes (list spwidth spheight))
    (send self :workmap-proportion propor)
    (setf *now-screen-size* 
          (list (min (max width  spwidth ) (first  (screen-size)))
                (min (max height spheight) (second (screen-size)))))
    (case *layout-choice*
      (0
       (send *vista* :normalsize t)
       (send *vista* :full-screen nil) 
       (setf *full-screen* nil))
      (1
       (send *vista* :normalsize nil)
       (send *vista* :full-screen nil) 
       (setf *full-screen* nil))
      (2
       (send *vista* :normalsize nil)
       (send *vista* :full-screen t) 
       (setf *full-screen* t)))
    (setf *screen-size* (- (list spwidth spheight) *screen-size-adjustment*))
    (setf screen-size *screen-size*)
    (send self :refresh-desktop :resize t)
    ;(when *update-pref-files* (save-desktop-settings)) removed because
    ; desktop not yet open and saves bad info about sizes, locs, etc.
    t))

(defmeth vista-system-object-proto :resize-desktop-dialog ()
  (let* ((workmap-propor (send self :workmap-proportion))
         (title 28) ;24
         (border  8);4
         (min-height-window (floor (/ (second (screen-size)) 3)))
         (desktop-sizes (send self :desktop-size))
         (dash-sizes (send self :datasheet-sizes))
         (splot-sizes (send self :spreadplot-sizes))
         (max-sizes (make-minmax-desktop-sizes 0))
         (min-sizes (make-minmax-desktop-sizes 1))
         (title1 (send text-item-proto :new (format nil 
                "Change Desktop Sizes (in pixels) to:")))
         (width-text (send text-item-proto :new 
            (format nil "Desktop Width (~d <= Width <= ~d)" 
                    (first min-sizes) (first max-sizes))))
         (width (send edit-text-item-proto :new 
                      (format nil "~d" (first desktop-sizes)) 
                      :text-length 4))
         (height-text (send text-item-proto :new 
                            (format nil "Desktop Height (~d <= Height <= ~d)"
                            (second min-sizes) (second max-sizes))))
         (height (send edit-text-item-proto :new 
                      (format nil "~d" (second desktop-sizes))
                       :text-length 4))
         (ratio (send edit-text-item-proto :new 
                      (format nil "~g" workmap-propor)
                      :text-length 4))
         (ratio-text (send text-item-proto :new
                      "WorkMap Proportion of Desktop Height"))
         (layout-type (send toggle-item-proto :new 
                            "Hide WorkMap Title Bar" 
                            :value (= *layout-type* 1)))
         (title2 (send text-item-proto :new (format nil 
                "Change SpreadPlot Sizes (in pixels) to:")))
         (spwidth-text (send text-item-proto :new 
            (format nil "SpreadPlot Width (~d <= Width <= ~d)"
                    (fourth min-sizes) (fourth max-sizes))))
         (spwidth (send edit-text-item-proto :new 
                      (format nil "~d" (first splot-sizes)) 
                        :text-length 4))
         (spheight-text (send text-item-proto :new 
            (format nil "SpreadPlot Height (~d <= Height <= ~d)" 
                    (fifth min-sizes) (fifth max-sizes))))
         (spheight (send edit-text-item-proto :new 
                      (format nil "~d" (second splot-sizes)) 
                         :text-length 4))
         (ok (send modal-button-proto :new "OK"
                   :action #'(lambda ()
                               (list (send width :text)
                                     (send height :text)
                                     (send ratio :text)
                                     (send spwidth :text)
                                     (send spheight :text)
                                     (send layout-type :value)))))
         (cancel (send modal-button-proto :new "Cancel"))
         (dialog (send modal-dialog-proto :new
                       (list title1 
                             (list width width-text)
                             (list height height-text)
                             (list ratio ratio-text)
                             layout-type
                             title2
                             (list spwidth spwidth-text)
                             (list spheight spheight-text)
                             (list ok cancel))
                       :default-button ok))
         )
    (send dialog :modal-dialog)))


(defmeth vista-system-object-proto :check-desktop-layout
                      (&optional result shortcut)
  (let* ((propor (send self :workmap-proportion))  
         (height nil)
         (width nil)
         (dsheight nil)
         (dswidth (first (send (if *datasheet* 
                                   *datasheet* 
                                   *fake-datasheet*) 
                               :size)))
         (wmwidth (first (send *workmap* :size)))
         (spheight nil)
         (spwidth nil)
         (max-sizes (make-minmax-desktop-sizes 0))
         (min-sizes (make-minmax-desktop-sizes 1))
         (new-size nil)
         (error-message)
         (ratio 1/2)
         (min-height-window (floor (/ (second (screen-size)) 3)))
         (offset 40)
         (border 4)
         (bad-numbers "You must enter numbers for all widths and heights.")
        )
    (flet ((resize-error-message (error-message this-error-message)
            (setf error-message (strcat (if error-message
                                            (strcat error-message "\n" this-error-message)
                                            this-error-message)))))
      
      (setf width (first result))
      (setf height (second result))
      (setf propor (third result))
      (setf spwidth (fourth result))
      (setf spheight (fifth result))
      (setf *layout-type* (if (sixth result) 1 0))
      (when (or (< (length width)  1) (< (length height) 1)
                (< (length propor) 1)
                (< (length spwidth) 1) (< (length spheight) 1))
            (fatal-message bad-numbers))
      (when (or (equal " " (remove-duplicates width))
                (equal " " (remove-duplicates height))
                (equal " " (remove-duplicates propor))
                (equal " " (remove-duplicates spwidth))
                (equal " " (remove-duplicates spheight)))
            (fatal-message bad-numbers))
      (setf height (read-from-string height))
      (setf width  (read-from-string width ))
      (setf propor (read-from-string propor))
      (setf spheight (read-from-string spheight))
      (setf spwidth  (read-from-string spwidth ))
      (when (or (not (numberp height))
                (not (numberp width))
                (not (numberp propor))
                (not (numberp spheight))
                (not (numberp spwidth)))
            (fatal-message bad-numbers))
      (when (or (> width    (first  max-sizes))
                (> spwidth  (fourth max-sizes)))
            (setf error-message
                  (resize-error-message error-message 
                        "One or both widths are too large.")))
      (when (or (< width    (first  min-sizes))
                (< spwidth  (second min-sizes)))
            (setf error-message
                  (resize-error-message error-message 
                        "One or both widths are too small.")))
      (when (or (> height   (second max-sizes))
                (> spheight (fifth  max-sizes))) 
            (setf error-message
                  (resize-error-message error-message 
                        "One or more heights are too large."))) 
      (when (or (< height   (second min-sizes))
                (< spheight (fifth  min-sizes)))
            (setf error-message
                  (resize-error-message error-message 
                        "One or more heights are too small.")))
      (when (not (<= 0 propor 1))
            (setf error-message
                  (resize-error-message error-message
                        "The proportion must be between 0 and 1")))
      (when error-message 
            (vista-message error-message)
            (top-level))
      (list width height propor spwidth spheight)
      )))